home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / oh_towns / townsfos / twfc.bas < prev    next >
BASIC Source File  |  1991-10-18  |  12KB  |  352 lines
  1. 10000 '
  2. 10010 ' TW-FC : Towns File Creater : By TaroPYON
  3. 10020 '
  4. 10030 '      TownsFOS 対応 アプリケーション
  5. 10040 '
  6. 10050 ' Filename "TWFC.BAS"
  7. 10060 '
  8. 10070 ' Last Update 1989. 5.17 Ver.1.01
  9. 10080 '
  10. 10090 '
  11. 10100 DEFINT A-Z
  12. 10110 DIM B(256)
  13. 10120 DIM SMX(15),SMY(15)
  14. 10130 DIM KASN$(15)
  15. 10140 RESTORE *KEY_ASN_TBL : FOR I=0 TO 15 : READ KASN$(I) : NEXT
  16. 10150 *KEY_ASN_TBL
  17. 10160 DATA  "0 ", "1,", "2.", "3/","4kK","5lL", "6;","7iI"
  18. 10170 DATA "8oO","9pP","aA-","bB^","cC@","dD[","eE:","fF]"
  19. 10180 DEF FNH$(HH,LL)=RIGHT$(STRING$(LL,"0")+HEX$(HH),LL)
  20. 10190 '
  21. 10200 CP&=0 : MP&=0
  22. 10210 CUP$=CHR$(&H1E)+CHR$(&H17):CDW$=CHR$(&H1F)+CHR$(&H18)
  23. 10220 CLT$=CHR$(&H1D)+CHR$(&H01):CRT$=CHR$(&H1C)+CHR$(&H04)
  24. 10230 CX=0:CY=0
  25. 10240 S_GRA%=-1
  26. 10250 '
  27. 10260 ' 画面初期化
  28. 10270 '
  29. 10280 COLOR 7,0 : WIDTH 80,25 : CONSOLE 23,2
  30. 10290 LOCATE 0,0:PRINT "||||| TW-FC : Towns File Creater : Ver.1.01 |||||";
  31. 10300 LOCATE 0,1:PRINT STRING$(80,"-");
  32. 10310 LOCATE 0,3:PRINT " OffSet +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F :SM: | A  S  C  I  I |";
  33. 10320 FOR Y=3 TO 21
  34. 10330  LOCATE 31,Y:PRINT "|";:LOCATE 56,Y:PRINT ":";
  35. 10340   LOCATE 59,Y:PRINT ":";
  36. 10350 NEXT
  37. 10360 LOCATE 0,20:PRINT " ";STRING$(79,"-");
  38. 10370 LOCATE 4,21:PRINT "SUM";
  39. 10380 GOTO *MAIN : 'GOSUB *PUT_1SEC
  40. 10390 '
  41. 10400 ' INKEY$
  42. 10410 '
  43. 10420 *KIN : K$="":WHILE K$="":K$=INKEY$:WEND
  44. 10430 RETURN
  45. 10440 '
  46. 10450 ' Clear Key Buffer
  47. 10460 '
  48. 10470 *KCLR : WHILE INKEY$<>"":WEND
  49. 10480 RETURN
  50. 10490 '
  51. 10500 ' 256バイト表示 : [OF&:オフセット
  52. 10510 '
  53. 10520 *PUT_1SEC
  54. 10530 SUM=0
  55. 10540 FOR P1_Y=0 TO 15
  56. 10550   P1_L$=RIGHT$("00000"+HEX$(OF&+P1_Y*16),6) : P1_M$=": " : P1_XS=0
  57. 10560   FOR P1_X=0 TO 15
  58. 10570     P1_A=B(P1_Y*16+P1_X)
  59. 10580     P1_L$=P1_L$+" "+RIGHT$("0"+HEX$(P1_A),2)
  60. 10590     I=P1_A:GOSUB *CHK_KANA
  61. 10600     IF (P1_A>=&H20 AND P1_A<=&H7E) OR R THEN P1_A$=CHR$(P1_A)                                                       ELSE P1_A$="･"
  62. 10610     P1_M$=P1_M$+P1_A$
  63. 10620     P1_XS=(P1_XS+P1_A) AND &HFF
  64. 10630     SUM=(SUM+P1_A) AND &HFF
  65. 10640   NEXT
  66. 10650   MID$(P1_L$,31,1)="|" : SMY(P1_Y)=P1_XS
  67. 10660   LOCATE 1,P1_Y+4:PRINT P1_L$+" :"+RIGHT$("0"+HEX$(P1_XS),2)+P1_M$;
  68. 10670 NEXT
  69. 10680 '
  70. 10690 P1_L$=""
  71. 10700 FOR P1_X=0 TO 15
  72. 10710   P1_YS=0
  73. 10720   FOR P1_Y=0 TO 15 : P1_YS=(P1_YS+B(P1_Y*16+P1_X)) AND &HFF : NEXT
  74. 10730   P1_L$=P1_L$+" "+RIGHT$("0"+HEX$(P1_YS),2):SMX(P1_X)=P1_YS
  75. 10740 NEXT
  76. 10750 MID$(P1_L$,25,1)="|"
  77. 10760 LOCATE 7,21:PRINT P1_L$+" :"+RIGHT$("0"+HEX$(SUM),2)+":"
  78. 10770 RETURN
  79. 10780 '
  80. 10790 ' CURSOR
  81. 10800 '
  82. 10810 *CUR_SUB : CU_A=B(CY*16+CX):CU_X=CX*3
  83. 10820 LOCATE 1,CY+4:PRINT RIGHT$("00000"+HEX$(CP&+CY*16),6);
  84. 10830 LOCATE 8+CU_X,3:PRINT "+"+HEX$(CX);
  85. 10840 LOCATE 8+CU_X,4+CY:IF EM THEN PRINT RIGHT$("0"+HEX$(CU_A),2);               ELSE IF IL=0 THEN PRINT HEX$(CU_A \ 16);                                    ELSE LOCATE 9+CU_X,4+CY:PRINT HEX$(CU_A AND 15);
  86. 10850 LOCATE 8+CU_X,21:PRINT RIGHT$("0"+HEX$(SMX(CX)),2);
  87. 10860 LOCATE 57,CY+4:PRINT RIGHT$("0"+HEX$(SMY(CY)),2);
  88. 10870 I=CU_A:GOSUB *CHK_KANA
  89. 10880 IF (CU_A>=&H20 AND CU_A<=&H7E) OR R THEN CU_A$=CHR$(CU_A)                                                       ELSE CU_A$="･"
  90. 10890 LOCATE 61+CX,CY+4:PRINT CU_A$;:COLOR 7
  91. 10900 LOCATE 57,21:PRINT RIGHT$("0"+HEX$(SUM),2);:RETURN
  92. 10910 '
  93. 10920 *CUR_ON : COLOR 15 : GOTO *CUR_SUB
  94. 10930 *CUR_OFF: COLOR  7 : GOTO *CUR_SUB 
  95. 10940 '
  96. 10950 ' 片仮名コードのチェック : I -> R<>0:KANA
  97. 10960 '
  98. 10970 *CHK_KANA
  99. 10980 IF I>=&HA1 AND I<=&HDF THEN R=-1 ELSE R=0
  100. 10990 RETURN
  101. 11000 '
  102. 11010 ' MAIN ROUTINE
  103. 11020 '
  104. 11030 *MAIN
  105. 11040 IF ARGC%>1 THEN FL$=ARGV$(1):GOTO *MA_1
  106. 11050   LOCATE 0,24 : LINE INPUT "Filename ? ",FL$:IF FL$="" THEN *END_EXIT
  107. 11060 *MA_1
  108. 11070 P=INSTR(FL$,":"):IF P>0 THEN FLR$=LEFT$(FL$,P)+"(1)"+MID$(FL$,P+1)                                  ELSE FLR$="(1)"+FL$
  109. 11080 A$="":FOR I=1 TO LEN(FL$):B$=MID$(FL$,I,1):IF B$>="a" AND B$<="z" THEN      A$=A$+CHR$(ASC(B$)-&H20) ELSE A$=A$+B$
  110. 11090 NEXT:FL$=A$
  111. 11100 LOCATE 50,0:PRINT SPC(30);
  112. 11110 LOCATE 50,0:PRINT LEFT$("Filename = "+FL$+" =",80-50);
  113. 11120 ON ERROR GOTO *ERR_OPEN
  114. 11130 OPEN "R",#1,FLR$ : FIELD #1,1 AS W_A$ : ON ERROR GOTO 0
  115. 11140 MP&=LOF(1) : CP&=(MP& AND &HFFFF00)
  116. 11150 '
  117. 11160 *PUT_AND_EDIT
  118. 11170 CLS 1:PRINT "Reading ...";
  119. 11180 LOCATE 61,21:PRINT "FileSize $";RIGHT$("00000"+HEX$(MP&),6);
  120. 11190 OF&=CP&
  121. 11200 FOR I=0 TO 255
  122. 11210   IF MP&>(CP&+I) THEN GET #1,CP&+I+1:A$=W_A$:B(I)=ASC(A$) ELSE B(I)=0
  123. 11220 NEXT
  124. 11230 GOSUB *PUT_1SEC
  125. 11240 GOTO *EDIT_PART
  126. 11250 '
  127. 11260 ' ERROR
  128. 11270 '
  129. 11280 *ERR_OPEN
  130. 11290 CLS 1 : PRINT "@@ Open Error : ";
  131. 11300 IF ARGC% THEN S_ERR%=ERR : RETURN *S_T_RETURN
  132. 11310 PRINT " Error #";ERR; : RESUME *MAIN
  133. 11320 '
  134. 11330 ' EDIT
  135. 11340 '
  136. 11350 *EDIT_PART
  137. 11360 CLS 1
  138. 11370 PRINT " Command [+,N:+256bytes   [-,B:-256byte  [S:Select [E:Exit"
  139. 11380 PRINT "         [ESC,H:Edit(hex) [A:Edit(Ascii) [C:Clear";
  140. 11390 *EDP_1 : GOSUB *KCLR : GOSUB *KIN
  141. 11400   IF INSTR(";+nN"+CDW$,K$) THEN *MV_NEXT
  142. 11410   IF INSTR("-=bB"+CUP$,K$) THEN *MV_BEFR
  143. 11420   IF INSTR("sS",K$) THEN *MV_SELECT
  144. 11430   IF INSTR("uU",K$) THEN *UNDO
  145. 11440   IF INSTR("eE",K$) THEN *EXIT
  146. 11450   IF INSTR("hH"+CHR$(27),K$) THEN EM=0:GOTO *F_EDIT
  147. 11460   IF INSTR("aA",K$) THEN EM=1:GOTO *F_EDIT
  148. 11470   IF INSTR("cC",K$) THEN *E_CLEAR
  149. 11480   I=ASC(K$):GOSUB *CHK_KANA:IF R THEN GOSUB *KANA_CUT:GOTO *EDIT_PART
  150. 11490 GOTO *EDP_1
  151. 11500 '
  152. 11510 ' EXIT
  153. 11520 '
  154. 11530 *EXIT
  155. 11540   CLS 1:PRINT "作業を終了しますか？ (Y/N) ";:GOSUB *KCLR
  156. 11550   *EX_1:GOSUB *KIN : IF INSTR("YyNn",K$)=0 THEN *EX_1
  157. 11560   IF K$="n" OR K$="N" THEN *EDIT_PART
  158. 11570   CLOSE
  159. 11580 *END_EXIT
  160. 11590   IF ARGC% THEN RETURN
  161. 11600   WIDTH : LOCATE 25,3 : PRINT "*** TW-FC : Good Bye.... ****"
  162. 11610   END
  163. 11620 '
  164. 11630 ' Pointer Move Next Block
  165. 11640 '
  166. 11650 *MV_NEXT
  167. 11660 MP&=LOF(1):CP&=CP& AND &HFFFF00
  168. 11670 IF MP&<=(CP&+256) THEN *MVN_1
  169. 11680   CP&=CP&+256:
  170. 11690   GOTO *PUT_AND_EDIT
  171. 11700 *MVN_1
  172. 11710 CLS 1:PRINT "Working..."
  173. 11720 FOR I=0 TO 255:B(I)=0:NEXT
  174. 11730 CP&=CP&+256:OF&=CP&
  175. 11740 GOSUB *PUT_1SEC
  176. 11750 GOTO *EDIT_PART
  177. 11760 '
  178. 11770 ' Pointer Move Before Block
  179. 11780 '
  180. 11790 *MV_BEFR
  181. 11800 MP&=LOF(1):CP&=CP& AND &HFFFF00
  182. 11810 IF CP&<256 THEN *EDIT_PART
  183. 11820   CP&=CP&-256
  184. 11830   GOTO *PUT_AND_EDIT
  185. 11840 '
  186. 11850 ' Pointer Move
  187. 11860 '
  188. 11870 *MV_SELECT
  189. 11880 CLS 1
  190. 11890 LOCATE 0,24:INPUT "Move Pointer ? $",A$
  191. 11900 P&=VAL("&H"+A$):IF INSTR(A$,"0")=0 AND P&=0 THEN *EDIT_PART
  192. 11910 Q=P& AND &HFF:P&=P& AND &HFFFF00
  193. 11920 IF MP&<=P& THEN *MVS_1
  194. 11930   CX=Q AND 15 : CY=Q \ 16 : IF CP&<>P& THEN CP&=P& ELSE *EDIT_PART
  195. 11940   GOTO *PUT_AND_EDIT
  196. 11950 *MVS_1
  197. 11960 CLS 1:PRINT "指定位置は($";FNH$(P&,6);
  198. 11970 PRINT ")はファイルサイズを($";FNH$(MP&,6);")を越えています。"
  199. 11980 PRINT "この位置に移動してよいですか？ (Y/N)";
  200. 11990 *MVS_2 : GOSUB *KIN
  201. 12000 IF INSTR("yYnN",K$)=0 THEN *MVS_2
  202. 12010 IF K$="n" OR K$="N" THEN *EDIT_PART
  203. 12020   CP&=P& : CX=Q AND 15 : CY=Q \ 16
  204. 12030   GOTO *PUT_AND_EDIT
  205. 12040 '
  206. 12050 ' Clear
  207. 12060 '
  208. 12070 *E_CLEAR
  209. 12080 CLS 1:PRINT "* 消去する範囲は"
  210. 12090       PRINT "  [1:表示中の256バイト [2:指定の範囲 [Q:中止 ?";
  211. 12100 *ECL_1 : GOSUB *KCLR : GOSUB *KIN
  212. 12110 IF INSTR("12qQ",K$)=0 THEN *ECL_1
  213. 12120 IF K$="q" OR K$="Q" THEN *EDIT_PART
  214. 12130 IF K$="2" THEN *ECL_2
  215. 12140 IF CP&>=MP& THEN *EDIT_PART
  216. 12150 CLS 1 : PRINT "Working...";
  217. 12160 IF (CP& \ 256)=(MP& \ 256) THEN M=(MP&-1) AND &HFF ELSE M=255
  218. 12170 FOR I=0 TO M : LSET W_A$=CHR$(0) : PUT #1,CP&+I+1 : NEXT""
  219. 12180 GOTO *PUT_AND_EDIT
  220. 12190 *ECL_2
  221. 12200 CLS 1:LOCATE 0,24 : INPUT "消去範囲の開始位置は？ $",A$:                    IF A$="" THEN *EDIT_PART
  222. 12210 S&=VAL("&H"+A$):IF INSTR("0",A$)=0 AND S&=0 THEN *EDIT_PART
  223. 12220 CLS 1:LOCATE 0,24 : INPUT "消去範囲の終了位置は？ $",A$:                    IF A$="" THEN *EDIT_PART
  224. 12230 E&=VAL("&H"+A$):IF (INSTR("0",A$)=0 AND E&=0) OR S&>=E& THEN *EDIT_PART
  225. 12240 CLS 1:PRINT "消去範囲 $";FNH$(S&,6);" から $";FNH$(E&,6);"まで"
  226. 12250       PRINT "消去してもよろしいですか？ (Y/N) ";
  227. 12260 *ECL_3:GOSUB *KCLR : GOSUB *KIN
  228. 12270 IF INSTR("yYnN",K$)=0 THEN *ECL_3
  229. 12280 IF K$="n" OR K$="N" THEN *EDIT_PART
  230. 12290 CLS 1:PRINT "Working...";
  231. 12300 FOR I&=S& TO E& : LSET W_A$=CHR$(0) : PUT #1,I&+1 : NEXT
  232. 12310 GOTO *PUT_AND_EDIT
  233. 12320 '
  234. 12330 ' INPUT PART
  235. 12340 '
  236. 12350 *F_EDIT:IL=0:IN_MAX&=CP&-1 '書換えのあった最大のポインタ
  237. 12360 *ED_TOP
  238. 12370 IF EM THEN A$="(ASC)" ELSE A$="(HEX)"
  239. 12380 CLS 1:PRINT   A$+"Edit: [TAB:Change Input Mode [ESC:Command"
  240. 12390       PRINT "           [BS: [HOME: [RET:";
  241. 12400 *ED_1:K$=""
  242. 12410 GOSUB *CUR_ON : GOSUB *KIN : GOSUB *CUR_OFF
  243. 12420 IF EM THEN *ED_3 ELSE A=-1
  244. 12430   FOR I=0 TO 15
  245. 12440     IF INSTR(KASN$(I),K$) THEN A=I
  246. 12450   NEXT : IF A<>-1 THEN I=A:GOTO *SET_HEX
  247. 12460 *ED_3
  248. 12470 IF INSTR(CUP$,K$) THEN IL=0:CY=CY-1:GOTO *ED_2
  249. 12480 IF INSTR(CDW$,K$) THEN IL=0:CY=CY+1:GOTO *ED_2
  250. 12490 IF INSTR(CLT$,K$) THEN IL=0:CX=CX-1:GOTO *ED_2
  251. 12500 IF INSTR(CRT$,K$) THEN IL=0:CX=CX+1:GOTO *ED_2
  252. 12510 IF K$=CHR$(8) THEN *E_BS
  253. 12520 IF K$=CHR$(13) THEN IL=0:CY=CY+1:CX=0:GOTO *ED_2
  254. 12530 IF K$=CHR$(9) THEN IL=0:EM=(EM+1) AND 1:GOTO *F_EDIT 'TAB
  255. 12540 IF K$=CHR$(11) THEN CX=0 : CY=0: GOTO *ED_1 : 'HOME
  256. 12550 IF K$=CHR$(27) THEN *E_ESC
  257. 12560 IF EM THEN I=ASC(K$):GOTO *SET_ANK
  258. 12570 I=ASC(K$):GOSUB *CHK_KANA:IF EM=0 AND R THEN GOSUB *KANA_CUT:GOTO *ED_TOP
  259. 12580 GOTO *ED_1
  260. 12590 '
  261. 12600 *ED_2
  262. 12610 IF CX<0 THEN IF CY=0 THEN CX=0 ELSE CY=CY-1:CX=15
  263. 12620 IF CX>15 THEN IF CY=15 THEN CX=15 ELSE CY=CY+1:CX=0
  264. 12630 IF CY<0 THEN CY=0
  265. 12640 IF CY>15 THEN CY=15
  266. 12650 WHILE INKEY$<>"":WEND 
  267. 12660 GOTO *ED_1
  268. 12670 '
  269. 12680 *KANA_CUT 
  270. 12690 CLS 1:PRINT "入力がカタカナになっています。英数モードにしてください。"
  271. 12700 PRINT SPC(16);"*** 何かキーを押してください｡ ***";
  272. 12710 GOSUB *KCLR : GOSUB *KIN
  273. 12720 RETURN
  274. 12730 '
  275. 12740 ' Return Command mode
  276. 12750 '
  277. 12760 *E_ESC : MP&=LOF(1)
  278. 12770 IF IN_MAX&<CP& THEN *EDIT_PART
  279. 12780 CLS 1:PRINT "Writing...";
  280. 12790 IF (MP& \ 256)<>(CP& \ 256) AND IN_MAX&<MP& THEN M=255                                                                  ELSE GOSUB *E_ESC_M
  281. 12800   FOR I=0 TO M
  282. 12810     LSET W_A$=CHR$(B(I)) : PUT #1,CP&+I+1
  283. 12820   NEXT
  284. 12830 MP&=LOF(1):LOCATE 71,21:PRINT FNH$(MP&,6);
  285. 12840 GOTO *EDIT_PART
  286. 12850 '
  287. 12860 *E_ESC_M
  288. 12870 IF MP&=0 THEN S&=0 ELSE S&=MP&-1
  289. 12880 FOR P&=S& TO IN_MAX& : LSET W_A$=CHR$(0):PUT #1,P&+1 : NEXT
  290. 12890 M=IN_MAX& AND &HFF
  291. 12900 RETURN
  292. 12910 '
  293. 12920 ' SET HEX MODE
  294. 12930 '
  295. 12940 *SET_HEX
  296. 12950 P=CY*16+CX : A=B(P) : SUM=SUM+256 : SX=SMX(CX)+256 : SY=SMY(CY)+256
  297. 12960 IF IL THEN *SET_H_1
  298. 12970   I=I*16 : H=I-(A AND &HF0) : SUM=SUM+H : SX=SX+H : SY=SY+H
  299. 12980   A=(A AND &H0F)+I
  300. 12990 GOTO *SET_H_2
  301. 13000 *SET_H_1
  302. 13010   L=I-(A AND &H0F) : SUM=SUM+L : SX=SX+L : SY=SY+L
  303. 13020   A=(A AND &HF0)+I
  304. 13030 *SET_H_2
  305. 13040 IF (CP&+P)>IN_MAX& THEN IN_MAX&=CP&+P
  306. 13050 B(P)=A : SUM=SUM AND &HFF: SMX(CX)=SX AND &HFF: SMY(CY)=SY AND &HFF
  307. 13060 EM=1:GOSUB *CUR_OFF:EM=0
  308. 13070 IF IL=0 THEN IL=1:GOTO *ED_1
  309. 13080 *SET_RET
  310. 13090   CX=CX+1
  311. 13100   IF CX>15 THEN CY=CY+1:IF CY>15 THEN CY=15:CX=15 ELSE CX=0
  312. 13110   IL=0
  313. 13120 GOTO *ED_1
  314. 13130 '
  315. 13140 ' SET ANK MODE
  316. 13150 '
  317. 13160 *SET_ANK 
  318. 13170 P=CY*16+CX : A=B(P): B(P)=I
  319. 13180   IF (CP&+P)>IN_MAX& THEN IN_MAX&=CP&+P
  320. 13190   F=256-A+I:SUM=(SUM+F) AND &HFF
  321. 13200   SMX(CX)=(SMX(CX)+F) AND &HFF : SMY(CY)=(SMY(CY)+F) AND &HFF
  322. 13210   GOSUB *CUR_OFF
  323. 13220 GOTO *SET_RET
  324. 13230 '
  325. 13240 ' BS
  326. 13250 '
  327. 13260 *E_BS
  328. 13270 SUM=SUM+256
  329. 13280 IF EM THEN *E_BS_ANK
  330. 13290 IF IL THEN *E_BS_L
  331. 13300   IF CX=0 AND CY=0 THEN *ED_1
  332. 13310   CX=CX-1:IF CX<0 THEN CX=15:CY=CY-1
  333. 13320   P=CY*16+CX : A=B(P) :SX=SMX(CX)+256 : SY=SMY(CY)+256
  334. 13330   L=A AND &H0F:SUM=SUM-L:SX=SX-L:SY=SY-L
  335. 13340   A=A AND &HF0:IL=1
  336. 13350 GOTO *E_BS_RET
  337. 13360 *E_BS_L
  338. 13370   P=CY*16+CX : A=B(P) : SX=SMX(CX)+256 : SY=SMY(CY)+256
  339. 13380   H=A AND &HF0:SUM=SUM-H:SX=SX-H:SY=SY-H
  340. 13390   A=A AND &H0F:IL=0
  341. 13400 GOTO *E_BS_RET
  342. 13410 *E_BS_ANK
  343. 13420   IF CX=0 AND CY=0 THEN *ED_1
  344. 13430   CX=CX-1:IF CX<0 THEN CX=15:CY=CY-1
  345. 13440   P=CY*16+CX : A=B(P) : SX=SMX(CX)+256 : SY=SMY(CY)+256
  346. 13450   SUM=SUM-A : SX=SX-A : SY=SY-A
  347. 13460   A=0
  348. 13470 *E_BS_RET
  349. 13480 B(P)=A : SUM=SUM AND &HFF : SMX(CX)=SX AND &HFF : SMY(CY)=SY AND &HFF
  350. 13490 A=EM : GOSUB *CUR_OFF : EM=A
  351. 13500 GOTO *ED_1
  352.